!
! mctrafo - color transformation
!
!
! Copyright © 2010-1 F.Hroch (hroch@physics.muni.cz)
!
! This file is part of Munipack.
!
! Munipack is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
! 
! Munipack is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
! 
! You should have received a copy of the GNU General Public License
! along with Munipack.  If not, see <http://www.gnu.org/licenses/>.
!
!
! This code needs for color conversions auxiliary file with transformation
! matrixes. The file is in free Fortran format as follows:
!
! 'input colorspace' 'output colorspace'
! n m
! a11 a12 .. a1m
! a21 a22 .. a2m
! ...
! an1 an2 .. anm
!
! The n,m are dimensions of the matrix. The matrix contains n x m items.
! No comments are allowed.
!


program mctrafo

  use color_transformation

  implicit none

  integer, parameter :: slen = 666
  character(len=slen) :: record,radek,line,cname,cspace,ctable,fname
  integer, dimension(:), allocatable :: id
  real, dimension(:), allocatable :: black, slope
  character(len=10),dimension(5) :: key
  integer :: n,i,ic,istat,nband
  logical :: it


  key(1) = 'INFO'           ! <argument> print some information
  key(2) = 'CTABLE'         ! filename of color transformation tables
  key(3) = 'OUTPUT'         ! name of output file (default 'color.fits')
  key(4) = 'COLORSPACE'     ! data stored in the colorspace
  key(5) = 'INPUT'          ! name of input file in color FITS specification


  cname = 'color.fits'
  cspace = ''
  ctable = 'ctable.dat'
  fname = ''
  nband = 0

  ! read input data
  n = 0
  do
     read(*,'(a)',end=99,iostat=istat) record
     if( istat /= 0 ) stop 'Unexpected data on input.'

     ic = index(record,'#')
     if( ic == 0 ) then
        radek = adjustl(record)
     else
        radek = adjustl(record(1:ic-1))
     end if

     do i = 1, size(key)
        it = index(radek,trim(key(i))) == 1
        if( it ) then

           line = radek(index(radek,'=')+1:)

           if( key(i) == 'INFO' ) then
              call inform(line)
              stop 'You have been informed.'
           end if

           if( key(i) == 'CTABLE' ) then
              read(line,*,iostat=istat) ctable
              if( istat /= 0 .or. ctable == '') &
                   stop 'An error during reading of the color matrix file name.'
           end if

           if( key(i) == 'INPUT' ) then
              read(line,*,iostat=istat) fname
              if( istat /= 0 .or. fname == '') &
                   stop 'An error during reading of the input file name.'
           end if

           if( key(i) == 'OUTPUT' ) then
              read(line,*,iostat=istat) cname
              if( istat /= 0 .or. cname == '') &
                   stop 'An error during reading of the output file name.'
           end if

           if( key(i) == 'COLORSPACE' ) then
              read(line,*,iostat=istat) cspace
              if( istat /= 0 .or. cspace == '' ) &
                   stop 'An error during reading of the output colorspace.'
           end if
        end if

     end do

     if( .not. it ) then

        if( index(radek,'NBAND') == 1 ) then

           read(radek(index(radek,'=')+1:),*,iostat=istat) nband
           if( istat /= 0 .or. nband <= 0 ) stop 'NBAND parameter read failed.'
           if( allocated(id) ) stop 'NBAND multiply specified ?'
           allocate(id(nband),black(nband),slope(nband))
           black = 0.0
           slope = 1.0

        else if( nband > 0 .and. n < nband .and. radek /= ' ') then

           n = n + 1
           read(radek,*,iostat=istat) id(n),black(n),slope(n)
           if( istat /= 0 ) stop 'Failed to parse an input record.'
        end if

     end if

  end do
99 continue

  if( n /= nband ) stop 'A full set of FITS files not specified.'

  if( .not. allocated(slope) ) then
     allocate(id(1),slope(1),black(1))
     slope = -1
  end if

  call ctrafo(fname,cname,cspace,ctable,black,slope)
  
  deallocate(id,black,slope)


contains

  subroutine inform(params)
    
    character(len=*),intent(in) :: params
    character(len=80) :: ilabel,olabel
    integer ndim,mdim
    real, dimension(:,:),allocatable :: cmatrix

    if( index(params,'colorspaces') > 0 ) then

       open(1,file=ctable,status='old')
       do
          read(1,*,end=90) ilabel, olabel
          write(*,*) trim(ilabel), ' > ',trim(olabel)
          read(1,*,end=90) ndim, mdim
          allocate(cmatrix(ndim,mdim))
          read(1,*,end=90) cmatrix
          deallocate(cmatrix)
       end do
90     close(1)

    end if


  end subroutine inform

end program mctrafo

